www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\xcomasp\nd_goto_picsp.asp
<%
'**************************************************************
' 新动软网站管理系统
' 官方网站: http://www.aspcpu.com
' 系统作者: 阮丁远(网名：天 下 程 序)
' Copyright 新动软网站管理系统 版权所有
'**************************************************************
%>
<%
'全局考虑，加on error resume next
on error resume next
dir_set="..\"
nodooooooa=0
if have_a1="" then
have_a1="1"
'***********************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
'Dim Fy_Url,Fy_a,Fy_x,Fy_Cs(),Fy_Cl,Fy_Ts,Fy_Zx
'---定义部份 头------
Fy_Cl = 2 '处理方式：1=提示信息,2=转向页面,3=先提示再转向
Fy_Zx = "/Error.Asp" '出错时转向的页面
'---定义部份 尾------
'ruandingyuan xiugai
Fy_Url=Request.ServerVariables("QUERY_STRING")
Fy_a=split(Fy_Url,"&")
redim Fy_Cs(ubound(Fy_a))
for Fy_x=0 to ubound(Fy_a)
Fy_Cs(Fy_x) = left(Fy_a(Fy_x),instr(Fy_a(Fy_x),"=")-1)
Next
For Fy_x=0 to ubound(Fy_Cs)
If Fy_Cs(Fy_x)<>"" Then
If Instr(LCase(Request(Fy_Cs(Fy_x))),"'")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and ")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and%20")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"select")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"update")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"set")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"chr")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"delete%20from")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"delete")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"from")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),";")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"insert")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"into")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"mid")<>0 Or Instr(LCase(Request(Fy_Cs(Fy_x))),"master.")<>0 Then
Select Case Fy_Cl
Case "1"
Response.Write "<Script Language=JavaScript>alert('出现错误！参数 "&Fy_Cs(Fy_x)&" 的值中包含非法字符串！\n\n 请不要在参数中出现：;,and%20,select%20,update%20,insert%20,delete,chr 等非法字符！);window.close();</Script>"
Case "2"
Response.Write "<Script Language=JavaScript>location.href='"&Fy_Zx&"'</Script>"
Case "3"
Response.Write "<Script Language=JavaScript>alert('出现错误！参数 "&Fy_Cs(Fy_x)&"的值中包含非法字符串！\n\n 请不要在参数中出现：;,and%20,select%20,update%20,insert%20,delete%20,chr 等非法字符！);location.href='"&Fy_Zx&"';</Script>"
End Select
nodooooooa=1
Response.End
End If
End If
Next
'post方式的sql注入，则直接禁止站点外部提交post
if lcase(Request.Servervariables("REQUEST_METHOD"))="post" then
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(server_v1,8,len(server_v2))<>server_v2 then
nodooooooa=1
response.write "<br><br><center><table border=1 cellpadding=20 bordercolor=black bgcolor=#EEEEEE width=450>"
response.write "<tr><td style='font:9pt Verdana'>"
response.write "你提交的路径有误,禁止从站点外部提交数据,请不要乱该参数！"
response.write "</td></tr></table></center>"
response.end
end if
end if
nd_web_output_folder_b="xndasp"
nd_web_output_folder_qiye_b="xcomasp"
'Dim ConnStr
if nodooooooa=0 then
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dir_set&"data\##%20newDdata8-5-2##.mdb")
Set newdsoft_conn_obj = Server.CreateObject("ADODB.Connection")
newdsoft_conn_obj.open ConnStr
If Err Then
Err.Clear
Set newdsoft_conn_obj = Nothing
Response.Write "数据库连接出错，请检查Conn.asp文件中的数据库参数设置。"
Response.End
End If
end if
if request("ruandingyuan_do")="getinfox" then
response.write "本站使用新"&""&"动"&"软系统制作,"&"系"&"统"&"作"&"者:"&"阮"&""&"丁"&"远,官网:ww"&"w.as"&"pcpu.com"
response.end
end if
J_True = "True"
J_False = "False"
J_Now = "Now()" '获得现在的时间
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
if is_haved_g_fontaa="" then
is_haved_g_fontaa="1"
Function getFontMode(str, vColor, vFont,vSize)
Dim FontStr, tColor
Dim ColorStr, arrColor
If IsNull(str) Then
getFontMode = ""
Exit Function
End If
getFontMode = str
FontStr=str
Select Case CInt(vFont)
Case 1
FontStr = "<b>" & str & "</b>"
Case 2
FontStr = "<em>" & str & "</em>"
Case 3
FontStr = "<u>" & str & "</u>"
Case 4
FontStr = "<b><em>" & str & "</em></b>"
Case 5
FontStr = "<b><u>" & str & "</u></b>"
Case 6
FontStr = "<em><u>" & str & "</u></em>"
Case 7
FontStr = "<b><em><u>" & str & "</u></em></b>"
Case Else
FontStr = str
End Select
getFontMode = FontStr
If vColor = "" Then Exit Function
'ColorStr = "," & InitTitleColor
'arrColor = Split(ColorStr, ",")
'If vColor > UBound(arrColor) Then Exit Function
'tColor = Trim(arrColor(vColor))
if vColor ="0" then
'ssscolor="<font style='font-size:"&vSize&" px;'>"
'ssscolor2="</font>"
else
'ssscolor="<font color="&vColor&" style='font-size:"&vSize&" px;'>"
'ssscolor2="</font>"
ssscolor="<span style='color:"&vColor&";'>"
ssscolor2="</span>"
end if
getFontMode = ssscolor& FontStr & ssscolor2
End Function
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
if haved_atype_a="" then
haved_atype_a="1"
function get_art_type(in1)
get_art_type=""
if in1="1" then get_art_type="<font color=red>[图文]</font>"
if in1="2" then get_art_type="<font color=red>[组图]</font>"
if in1="3" then get_art_type="<font color=red>[新闻]</font>"
if in1="4" then get_art_type="<font color=red>[推荐]</font>"
if in1="5" then get_art_type="<font color=red>[注意]</font>"
if in1="6" then get_art_type="<font color=red>[转载]</font>"
if in1="7" then get_art_type="<font color=red>[最新]</font>"
end function
end if
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
function findx_price(grade_id,str)
rst2=""
if str<>"" then
other_params=split(str,"|")
for i=0 to ubound(other_params)
sss11=split(other_params(i),":")
sss11a=sss11(0)
sss11b=sss11(1)
if cstr(sss11a)=cstr(grade_id) then
rst2=sss11b
exit for
end if
next
end if
if isnumeric(rst2)<>true then
rst2=""
end if
findx_price=rst2
end function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
Function n_RemoveHTML_mdx(strHTML)
n_RemoveHTML_md=""
on error resume next
strHTML=cstr(strHTML&"")
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍历匹配集合，并替换掉匹配的项目
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
n_RemoveHTML_mdx=strHTML
Set objRegExp = Nothing
End Function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
function replace_huanhangz(cont)
cont=replace(cont,vbcrlf,"$$sx_aspcodex_huanhang$")
cont=replace(cont,chr(10),"$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(13), "$$sx_aspcodex_huanhang$")
cont= Replace(cont, CHR(9), "$$sx_aspcodex_huanhang$")
cont=replace(cont,"=","$zzdenghaoaspcpu1$")
cont=replace(cont,"&","$zzadnnhaoaspcpu1$")
cont=replace(cont,"?","$zzwnnehaoaspcpu1$")
replace_huanhangz=cont
end function
'放在这，以免标签循环嵌套导致本函数循环定义而导致asp错误
Function UrlEncoding_x(DataStr)
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr, Si, 1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00) \ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding_x = StrReturn
End Function
%><%
'**************************************************************
' 新 动 软 网 站 管 理系统
' 系统作者: 阮 丁 远(网名：天 下 程 序)
' Copyright (C) 新 动 软 网站 管 理 系 统 版 权 所有
'**************************************************************
%>
<%
if have_added_funb="" then
have_added_funb=1
isnnn=0
function isnnum(num1)
If isnumeric(num1) = 0 Or IsNull(num1) or num1 = "" Then
isnnn=0
else
isnnn=1
end if
end function
function isddat(n1)
If n1 = "" Or IsNull(n1) or IsDate(n1)=false Then
isnnn=0
else
isnnn=1
end if
end function
function isyn(n1)
isnnn=9999
If n1 = true or n1=1 Then
isnnn=1
end if
If n1 = false or n1=0 Then
isnnn=0
end if
end function
function get_rs_value(num1)
execute("rsaaaaaaa1="&rsxxx1112&"("&num1&")")
get_rs_value=rsaaaaaaa1
end function
Function nohtml(ByVal str)
Set regEx = New RegExp
If IsNull(str) Or Trim(str) = "" Then
nohtml = ""
Exit Function
End If
regEx.Pattern = "(\<.[^\<]*\>)"
str = regEx.Replace(str, "")
regEx.Pattern = "(\<\/[^\<]*\>)"
str = regEx.Replace(str, "")
regEx.Pattern = "\[NextPage(.*?)\]" '解决“当在文章模块的频道中发布的是图片并使用分页标签[NextPage]或内容开始的前几行就使用分页标签时，一旦使用搜索来搜索该文时，搜索页就会显示分页标签”的问题
str = regEx.Replace(str, "")
str = Replace(str, "'", "")
str = Replace(str, Chr(34), "")
str = Replace(str, vbCrLf, "")
str = Trim(str)
nohtml = str
End Function
Public Function ReplaceBadChar(strChar)
If strChar = "" Or IsNull(strChar) Then
ReplaceBadChar = ""
Exit Function
End If
'Dim strBadChar, arrBadChar, tempChar, i
strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:,exists,select,update,insert,=," & Chr(34) & "," & Chr(0) & ""
arrBadChar = Split(strBadChar, ",")
tempChar = strChar
For i = 0 To UBound(arrBadChar)
tempChar = Replace(tempChar, arrBadChar(i), "")
Next
ReplaceBadChar = tempChar
End Function
Function GetSubStr(ByVal str, ByVal strlen, bShowPoint)
If str = "" Then
GetSubStr = ""
Exit Function
End If
'Dim l, t, c, i, strTemp
str = Replace(Replace(Replace(Replace(str, " ", " "), """, Chr(34)), ">", ">"), "<", "<")
l = Len(str)
t = 0
strTemp = str
If strlen = "" Then
strlen = 0
Else
strlen = CLng(strlen)
End If
For i = 1 To l
c = Abs(Asc(Mid(str, i, 1)))
If c > 255 Then
t = t + 2
Else
t = t + 1
End If
If t >= strlen Then
strTemp = Left(str, i)
Exit For
End If
Next
If strTemp <> str And bShowPoint = True Then
strTemp = strTemp & "…"
End If
GetSubStr = Replace(Replace(Replace(Replace(strTemp, " ", " "), Chr(34), """), ">", ">"), "<", "<")
End Function
ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))
Action = Trim(Request("Action"))
FoundErr = False
ErrMsg = ""
If Right(InstallDir, 1) <> "/" Then
strInstallDir = InstallDir & "/"
Else
strInstallDir = InstallDir
End If
Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")
'*************************************************
'函数名：gotTopic
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
if isnull(str) or str="" then
gotTopic=""
exit function
end if
'dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
gotTopic=left(str,i) & "…"
exit for
else
gotTopic=str
end if
next
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
end function
'**************************************************
'函数名：strLength
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
'ON ERROR RESUME NEXT
'dim WINNT_CHINESE
WINNT_CHINESE = (len("中国")=2)
if WINNT_CHINESE then
'dim l,t,c
'dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function
end if
%>
<%'complie-link:label-strat[$$nd_goto_picsp_url($xx_request_asp$softid,$xx_request_asp$channel)] %><!--nd_complie_linkx_start:[$$nd_goto_picsp_url($xx_request_asp$softid,$xx_request_asp$channel)]xx-->
<%
'**************************************************************
' 新 动 软 网 站 管 理系统
' 系统作者: 阮 丁 远(网名：天 下 程 序)
' Copyright (C) 新 动 软 网站 管 理 系 统 版 权 所有
'**************************************************************
%>
<table border="0" cellpadding="0" cellspacing="0" ><%
sql="select [ND_pic_or_sp].id,[ND_pic_or_sp].sys_content_type,[ND_pic_or_sp].title,[ND_pic_or_sp].sub_title,[ND_pic_or_sp].classid,[ND_pic_or_sp].SpecialID,[ND_pic_or_sp].xingji,[ND_pic_or_sp].titleColor,[ND_pic_or_sp].titleFont,[ND_pic_or_sp].index_page_pic,[ND_pic_or_sp].content,[ND_pic_or_sp].is_outlink,[ND_pic_or_sp].outlink,[ND_pic_or_sp].Author_nick,[ND_pic_or_sp].is_new,[ND_pic_or_sp].is_tuijian,[ND_pic_or_sp].isTop,[ND_pic_or_sp].Hits,[ND_pic_or_sp].DayHits,[ND_pic_or_sp].MonthHits,[ND_pic_or_sp].HitsTime,[ND_pic_or_sp].WriteTime,[ND_pic_or_sp].username,[ND_pic_or_sp].out_and_inner_img_list,[ND_pic_or_sp].Uploadfile_list,[ND_pic_or_sp].UploadImage_list,[ND_pic_or_sp].is_shenhe,[ND_pic_or_sp].is_can_pinlun,[ND_pic_or_sp].liulang_dengji_group_id,[ND_pic_or_sp].DownAddress from [ND_pic_or_sp] where [ND_pic_or_sp].id="&request("softid")&""
set rs_x=server.CreateObject("adodb.recordset")
rs_x.open sql,newdsoft_conn_obj,1,1
if not rs_x.eof then
%><tr><td align="center">
<%
sssesfs=split(rs_x("DownAddress"),"|")
sssesfsdd=split(sssesfs(cint(request("channel"))),",")
sssesfsdd1=replace(sssesfsdd(0),"-xxnewdsofthtrd121a232_douhao-",",")
sssesfsdd1=replace(sssesfsdd1,"-xxnewdsofthtrd121a232_shuhao-","|")
response.redirect sssesfsdd1
response.end
%>
<table border="0">
<tbody>
<tr>
<td>d</td>
</tr>
</tbody>
</table></td></tr><%else%>
<tr><td align="center">
<strong>没有内容……</strong>
</td></tr>
<%end if%></table><!--nd_complie_linkx_end:[$$nd_goto_picsp_url($xx_request_asp$softid,$xx_request_asp$channel)]xx--><%'complie-link:label-end[$$nd_goto_picsp_url($xx_request_asp$softid,$xx_request_asp$channel)] %>